perm filename SCAN.SAI[DIA,HPM] blob sn#501150 filedate 1980-03-07 generic text, type T, neo UTF8
BEGIN "SCAN"
REQUIRE "VIXHDR.SAI[VIS,HPM]" SOURCE_FILE;
INTEGER IPIC_HI,IPIC_LO,PW,PH,PB,PIC_SIZ; STRING IPIC_NAME,INST;
INTEGER ARRAY PIC_DIM[0:10]; BOOLEAN ERR;

DO
   BEGIN "get file names"
   OUTSTR("FILES (eg OBS(3:15)):");  INST←INCHWL;
      BEGIN "decode file specs"
      INTEGER I,J;
      ERR←FALSE;
      IPIC_NAME←"";
      WHILE INST≠"(" AND LENGTH(INST)>0 DO IPIC_NAME←IPIC_NAME&LOP(INST);
      IF INST="(" THEN 
	 BEGIN
	 IPIC_LO←INTSCAN(INST,J);   IF J≠":" THEN ERR←TRUE;
	 IPIC_HI←INTSCAN(INST,J);   IF J≠")" THEN ERR←TRUE;
	 J←LOP(INST);  IPIC_NAME←IPIC_NAME&INST;
	 PRSFIL(""); PRSFIL(IPIC_NAME);
	 END;
      END "decode file specs";
   END 
UNTIL ¬ERR ∧ (PIC_SIZ←GETPFD("."&CVS(IPIC_LO),PIC_DIM[0]))>0;
   BEGIN
   INTEGER I,PIC_ID;
   INTEGER ARRAY PIC[0:PIC_SIZ];
   INTEGER ARRAY DDB[2:4,0:DDSIZ];

   DDINIT; FOR I←2 STEP 1 UNTIL 4 DO DDSTOR(DDB[I,0]);
MAPMON(1,54);
   FOR PIC_ID←IPIC_LO STEP 1 UNTIL IPIC_HI DO
      BEGIN
      INTEGER CNT,CM18,I;
      CNT←PIC_ID - IPIC_LO;  CM18←CNT MOD 18;
      CNT←(CNT - CM18) + (IF CM18<9 THEN CM18 ELSE 26-CM18);
      CNT←CNT+IPIC_LO;
      SETFORMAT(0,0);
      PRSFIL(""); PRSFIL(IPIC_NAME); GETPFL("."&CVS(CNT),PIC[0]);
      VIDFGX(PIC[0],DDB[4,0],DDB[3,0],DDB[2,0],DBUF,0,0);
      IF (CNT MOD 2)=0 THEN
	 BEGIN
	 DPYUP(SYNMAP(0));
	 FOR I←1 STEP 1 UNTIL 3 DO IF SYNMAP(I)>0
	    THEN DPYUP(SYNMAP(I),LOCATION(DDB[I+1,0]));
         END
      ELSE
	 BEGIN
	 IF SYNMAP(4)>0 THEN DPYUP(SYNMAP(4));
	 FOR I←1 STEP 1 UNTIL 3 DO IF SYNMAP(I+4)>0
	    THEN DPYUP(SYNMAP(I+4),LOCATION(DDB[I+1,0]));
         END;

	 BEGIN "MAPSET"
	 REAL PROCEDURE F(REAL X);
	    BEGIN
	    INTEGER IX,NX;
	    IF (CNT MOD 2)=1 THEN
	       BEGIN
	       IX←X * '400;
	       IX←IX LAND '17;
	       END
	    ELSE
	       IX←X * '20;
	    RETURN(IX/'20);
	    END;

	 MAPSET(F,FALSE);
	 END "MAPSET"
      END;
   END;



END "SCAN";